VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "cThread"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

'two Event-Naming-Conventions, for communication with the vbRichClients hidden cThreadProxy-Class (not reaching the clients, when raised)
Event CancelCheck(Cancel As Boolean)  'ask the hosting cThreadProxy, whether a client demanded Job-Cancelling
Event GetFactory(Factory As cFactory) 'ask the cThreadProxy, to deliver a RichClient-Factory-Instance regfree (not used here in this Demo)

'but this is a true User-receivable Event (just define and raise it normally, as any other VB-Event)
Event ScanProgress(ByVal FilesCount As Long)

Private Cnn As cConnection, Cmd As cCommand, JobsCancelled As Boolean
 
Public Function StartScan(Path As String, Optional Filter As String) As Long
  JobsCancelled = False
  
  If Cnn Is Nothing Then 'create the Connection, along with the Table and CommandObject
    Set Cnn = New_c.Connection
        Cnn.CreateNewDB "file:DirScanDB?mode=memory&cache=shared" 'open an InMem-Connection with a "shared-memory-file-URI"
        Cnn.Synchronous = False: Cnn.Execute "Pragma journal_mode=off"  'these settings will increase the Insert-Performance a bit

    'in the MainThread we already created our Table as: "Create Table Scan(ID Integer Primary Key, FileDate Date, FileLen Integer, FileName Text, FilePath Text)"
    Set Cmd = Cnn.CreateCommand("Insert Into Scan Values(?,?,?,?,?)") 'so we reflect the above 5 Fields in our Insert-Command-Definition
  End If
  
  Cnn.Execute "Delete From Scan" 'make sure we empty the Scan-DBTable before we dive into the DirList-recursion
  
  If AbortProcessing Then Exit Function
  
  DirScanRecursive Path, Filter, StartScan
End Function

Private Sub DirScanRecursive(Path As String, Filter As String, FilesScanned As Long)
  Static LastT As Double, T As Double
  Dim i As Long, DL As cDirList
  
  On Error GoTo SkipAccessDenied 'don't bother with Directories, which we have no access-rights for
    Set DL = New_c.FSO.GetDirList(Path, , Filter, True)
  On Error GoTo 0
  
  If AbortProcessing Then Exit Sub 'ask occasionally if we should cancel (in-between time-consuming sub-tasks)

  For i = 0 To DL.FilesCount - 1
    Cmd.SetNull 1
    Cmd.SetDate 2, DL.FileLastWriteTime(i)
    Cmd.SetInt64 3, DL.FileSize(i)
    Cmd.SetText 4, DL.FileName(i)
    Cmd.SetText 5, DL.Path
    Cmd.Execute
    FilesScanned = FilesScanned + 1
  Next
  
  If DL.FilesCount Then
    If AbortProcessing Then Exit Sub 'ask occasionally if we should cancel (in-between time-consuming sub-tasks)
    T = New_c.HPTimer
    If T - LastT > 0.2 Then 'no need to inform the Main-Thread more than about 5 times per second
      LastT = T: RaiseEvent ScanProgress(FilesScanned) 'raise the User-Event (it will be received back in the Main-Thread)
    End If
  End If
  
  For i = 0 To DL.SubDirsCount - 1
    DirScanRecursive DL.Path & DL.SubDirName(i), Filter, FilesScanned
    If AbortProcessing Then Exit Sub 'ask occasionally if we should cancel (in-between time-consuming sub-tasks)
  Next
SkipAccessDenied:
End Sub

Private Function AbortProcessing() As Boolean 'helper-function to signalize early exits in the Job-Procedures
  If Not JobsCancelled Then RaiseEvent CancelCheck(JobsCancelled) 'by raising the appropriate Helper-Event
  AbortProcessing = JobsCancelled
End Function
